home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / combox.exe / COMBODEM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-12-24  |  4.1 KB  |  173 lines
  1. Program ComboDemo;
  2. uses App, Objects, Drivers, Memory, Views, Menus, Dialogs,
  3.      StdDlg, MsgBox, Combo;
  4.  
  5. { This is a do-nothing application to demonstrate the use of the
  6.   combo box in Turbo Vision. }
  7.  
  8. const
  9.   cmShowDialog = 1000;
  10.  
  11. type
  12.   PNameEntry = ^TNameEntry;
  13.   TNameEntry = object(TObject)
  14.     Name : PString;
  15.     constructor Init(NewName : string);
  16.     destructor Done; virtual;
  17.   end;
  18.  
  19.   PNameList = ^TNameList;
  20.   TNameList = object(TComboCollection)
  21.     function TxtPtr(Item : integer) : String; virtual;
  22.     function KeyOf(Item: Pointer): Pointer; virtual;
  23.     function Compare(Key1, Key2: Pointer): Integer; virtual;
  24.   end;
  25.  
  26.   TDemo = object(TApplication)
  27.     NameList : PNameList;
  28.     constructor Init;
  29.     destructor Done; virtual;
  30.     procedure HandleEvent(var Event: TEvent); virtual;
  31.     procedure InitMenuBar; virtual;
  32.     procedure InitStatusLine; virtual;
  33.   end;
  34.  
  35. constructor TNameEntry.Init;
  36. begin
  37.   TObject.Init;
  38.   Name := NewStr(NewName);
  39. end;
  40.  
  41. destructor TNameEntry.Done;
  42. begin
  43.   DisposeStr(Name);
  44.   TObject.Done;
  45. end;
  46.  
  47. {This function is required. You MUST override this function in order
  48. to send the ComboBox a string to display corresponding to Item.}
  49. function TNameList.TxtPtr;
  50. begin
  51.   TxtPtr := PNameEntry(At(Item))^.Name^;
  52. end;
  53.  
  54. function TNameList.KeyOf;
  55. begin
  56.   KeyOf := PNameEntry(Item)^.Name;
  57. end;
  58.  
  59. function TNameList.Compare;
  60. begin
  61.   if PString(Key1)^ < PString(Key2)^ then Compare := -1 else
  62.   if PString(Key1)^ = PString(Key2)^ then Compare := 0 else
  63.   if PString(Key1)^ > PString(Key2)^ then Compare := 1;
  64. end;
  65.  
  66. constructor TDemo.Init;
  67. begin
  68.   TApplication.Init;
  69.   InitMenuBar;
  70.   InitStatusLine;
  71.   {Make a list and stick some stuff in it.}
  72.   NameList := New(PNameList, Init(10,5));
  73.   with NameList^ do
  74.   begin
  75.     Insert(New(PNameEntry, Init('GREER, KEITH')));
  76.     Insert(New(PNameEntry, Init('WRIGHT, WILBUR')));
  77.     Insert(New(PNameEntry, Init('BUSH, GEORGE')));
  78.     Insert(New(PNameEntry, Init('CLINTON, BILL')));
  79.     Insert(New(PNameEntry, Init('PEROT, ROSS')));
  80.     Insert(New(PNameEntry, Init('EARP, WYATT')));
  81.     Insert(New(PNameEntry, Init('PRESLEY, PRISCILLA')));
  82.     Insert(New(PNameEntry, Init('ASPIN, LES')));
  83.     Insert(New(PNameEntry, Init('KENNEDY, GEORGE')));
  84.     Insert(New(PNameEntry, Init('DONALDSON, SAM')));
  85.   end;
  86.  
  87. end;
  88.  
  89. procedure TDemo.InitMenuBar;
  90. var
  91.   R: TRect;
  92. begin
  93.   GetExtent(R);
  94.   R.B.Y := R.A.Y+1;
  95.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  96.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  97.       NewItem('~D~emo Dialog','', kbNoKey, cmShowDialog, hcNoContext,
  98.       NewLine(
  99.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext, nil)))),
  100.                    nil))));
  101. end;
  102.  
  103. procedure TDemo.InitStatusLine;
  104. var
  105.   R: TRect;
  106. begin
  107.   GetExtent(R);
  108.   R.A.Y := R.B.Y - 1;
  109.   StatusLine := New(PStatusLine, Init(R,
  110.     NewStatusDef(0, 4,
  111.       NewStatusKey('~F2~ Show Demo Dialog', kbF2, cmShowDialog,
  112.       NewStatusKey('~F10~ Menu', kbF10, cmMenu,
  113.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  114.       nil))),
  115.       nil)));
  116. end;
  117.  
  118. procedure TDemo.HandleEvent;
  119.  
  120. procedure ShowDialog;
  121. var
  122.   Bounds, R : TRect;
  123.   D : PDialog;
  124.   B : pointer;
  125. begin
  126.   Bounds.Assign(0,0,45,10);
  127.   D := New(PDialog, Init(Bounds, 'Combo Box Demo'));
  128.   with D^ do
  129.   begin
  130.     Options := Options or ofCentered;
  131.     R.Assign(2,3,37,4);
  132.     B := New(PInputLine, Init(R, 35));
  133.     R.Assign(37,3,40,4);
  134.     Insert(B);
  135.     Insert(New(PComboBox, Init(R, B, NameList)));
  136.     R.Assign(2,2,37,3);
  137.     Insert(New(PLabel, Init(R, 'Sample Input Line', B)));
  138.   end;
  139.   DeskTop^.ExecView(D);
  140.   Dispose(D, Done);
  141. end;
  142.  
  143. begin {TDemo.HandleEvent}
  144.   TApplication.HandleEvent(Event);
  145.   case Event.What of
  146.     evCommand:
  147.       begin
  148.         case Event.Command of
  149.           cmShowDialog : ShowDialog;
  150.         else
  151.           Exit;
  152.         end;
  153.         ClearEvent(Event);
  154.       end;
  155.   end;
  156. end;
  157.  
  158. destructor TDemo.Done;
  159. begin
  160.   Dispose(NameList,Done);
  161.   TApplication.Done;
  162.   WriteLn('Have fun with TComboBox!');
  163. end;
  164.  
  165. var
  166.   Demo : TDemo;
  167.  
  168. begin
  169.   Demo.Init;
  170.   Demo.Run;
  171.   Demo.Done;
  172. end.
  173.